home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyGetZoneList.p < prev    next >
Encoding:
Text File  |  1994-08-04  |  2.0 KB  |  97 lines  |  [TEXT/PJMM]
  1. unit MyGetZoneList;
  2.  
  3. interface
  4.  
  5.     function MyGetMyZone: str255;
  6.     function MyGetZoneList (datap: ptr; var size: longInt; var count: integer): OSErr;
  7.     function MyGetNextZone (var datap: ptr): str255;
  8.  
  9. implementation
  10.  
  11.     uses
  12.         Appletalk;
  13.  
  14.     function MyGetMyZone: str255;
  15.         var
  16.             xpp: XPPParamBlock;
  17.             oe: OSErr;
  18.             s: str255;
  19.     begin
  20.         xpp.zipInfoField[1] := 0;
  21.         xpp.zipInfoField[2] := 0;
  22.         xpp.xppTimeOut := 4;
  23.         xpp.xppRetry := 2;
  24.         xpp.zipBuffPtr := @s;
  25.         xpp.ioRefNum := XPPRefNum;        { driver refNum -41 }
  26.         xpp.csCode := xCall;
  27.         xpp.xppSubCode := zipGetMyZone;
  28.         oe := PBControlSync(@xpp);
  29.         if oe <> noErr then
  30.             s := '*';
  31.         MyGetMyZone := s;
  32.     end;
  33.  
  34.     procedure ClearBlock (cb: ptr; size: longInt);
  35.         var
  36.             p: longint;
  37.     begin
  38.         for p := longInt(cb) to longInt(cb) + size - 1 do
  39.             ptr(p)^ := -27;
  40.     end;
  41.  
  42.     function MyGetZoneList (datap: ptr; var size: longInt; var count: integer): OSErr;
  43.         var
  44.             xpp: XPPParamBlock;
  45.             oe: OSErr;
  46.             i: integer;
  47.             p: ptr;
  48.             buffer: packed array[1..578] of byte;
  49.             b: integer;
  50.             len: integer;
  51.     begin
  52.         ClearBlock(@xpp, sizeof(xpp));
  53.         xpp.ioRefNum := XPPRefNum;        { driver refNum -41 }
  54.         xpp.csCode := xCall;
  55.         xpp.xppSubCode := zipGetZoneList;
  56.         xpp.xppTimeout := 4;
  57.         xpp.xppRetry := 2;
  58.         xpp.zipBuffPtr := @buffer;
  59.         xpp.zipInfoField[1] := 0;
  60.         xpp.zipInfoField[2] := 0;
  61.         count := 0;
  62.         p := datap;
  63.         repeat
  64.             oe := PBControlSync(@xpp);
  65.             if oe = noErr then begin
  66.                 b := 1;
  67.                 for i := 1 to xpp.zipNumZones do begin
  68.                     len := buffer[b] + 1;
  69.                     if size - (ord(p) + len - ord(datap)) > 0 then begin
  70.                         BlockMove(@buffer[b], p, len);
  71.                         p := ptr(ord(p) + len);
  72.                     end;
  73.                     b := b + len;
  74.                 end;
  75.             end;
  76.             count := count + xpp.zipNumZones;
  77.         until (oe <> noErr) or (xpp.zipLastFlag <> 0);
  78.         size := ord(p) - ord(datap);
  79.         if oe <> noErr then begin
  80.             size := 0;
  81.             count := 0;
  82.         end;
  83.         MyGetZoneList := oe;
  84.     end;
  85.  
  86.     function MyGetNextZone (var datap: ptr): str255;
  87.         var
  88.             s: str255;
  89.             len: integer;
  90.     begin
  91.         len := BAND(datap^, $FF);
  92.         BlockMove(datap, @s, len + 1);
  93.         datap := ptr(ord(datap) + len + 1);
  94.         MyGetNextZone := s;
  95.     end;
  96.  
  97. end.